Chip 1997 May/CHIP Mayıs 1997.iso/cont/web/winsock/netxray/data.1/RIPCSV.BAS

BASIC Source File | 1995-12-15 | 7.1 KB | 301 lines

'
' This Basic script demonstrates NetXRay ability to import
' IP Address Table file into the Address book.
' The imported file must contain the following fields
'
' "Hostname","TCP/IP Address","Location","LAN Type","Full Name","LAN Address","Phone","Serial Number","Application","Model"
'
' For Example
'
' "receiver","124.45.103.67","Candle Stick","Ethernet","Rice, Jerry","0800203498ad","1123","555-1213","SOLARIS 2.3","SPARCSTATION 5"
'
' An example of this file 'ipdbsamp.csv' is included in the release.

' Basic Program Notes:
'
' Note the new keyword "App" that replaces "Lib <libname>" in the Declare
' statement when the function resides in the App that is calling Enable

Declare Sub mcb App (ByVal ctx&, ByVal type%, ByVal errno%, ByVal str$)
Declare Function OpenTextFile App (ByVal filename$) As Integer
Declare Function CloseTextFile App (ByVal fid%) As Integer
Declare Function ReadTextLine App (ByVal fid%, ByVal buf$) As Integer
Declare Function MyGetOpenFilename App (ByVal filename$, ByVal fileExt$, ByVal fileInit$, ByVal filter$) As Integer

Dim g_linebuf$ As String * 256
Dim g_buflen% As Integer
Dim g_filename$ As String * 256

Sub Main ()
    Dim fid% As Integer
    Dim a_char$ As String
    Dim buf$ As String
    Dim appObj As object
    Dim addrBookObj As object
    Dim FileExt$ As String
    Dim FileInitName$ As String
    Dim FileFilter$ As String

    Set appObj = CreateObject("NetXRay.Application.1")
    Set addrBookObj = appObj.GetAddressBookDoc()

    FileInitName$ = "*.csv"
    FileFilter$ = "CSV (Comma delimited) | *.csv ||"
    FileExt$ = "csv"

    bOpen% = MyGetOpenFilename(g_filename$, FileExt$, FileInitName$, FileFilter$)
    If bOpen% = 0 Then
        GoTo CancelOpen
    End If

    fid% = OpenTextFile(g_filename$)
    If fid% > 0 Then
        Do
NextLine:
            g_buflen% = ReadTextLine(fid%, g_linebuf$)
            If g_buflen% <= 0 Then
                'Exit Do
                GoTo EndOfFile
            End If

            buf$ = StripLeadingSpace(g_linebuf$)

            'not enough data
            'g_buflen% = Len(buf$)
            If Len(buf$) < 5 Then
                GoTo NextLine
            End If

            'skip the comment
            a_char$ = Left$(buf$, 1)
            If a_char$ = "#" Then
                GoTo NextLine
            End If

            'get the Host name'
            HostName$ = GetDCSWord(buf$, 1)
            If Len(HostName$) <= 2 Then
                GoTo NextLine
            End If
            HostName$ = StripQuote(HostName$)

            'get the IP token
            IPaddr$ = GetDCSWord(buf$, 2)
            If Len(IPaddr$) <= 2 Then
                IPaddr$ = "000.000.000.000"
            Else
                IPaddr$ = StripQuote(IPaddr$)
            End If

            'get the Location token
            Location$ = GetDCSWord(buf$, 3)
            Location$ = StripQuote(Location$)

            'get the LAN type token
            LANtype$ = GetDCSWord(buf$, 4)
            LANtype$ = StripQuote(LANtype$)


            'get the LAN Address token
            LANaddr$ = GetDCSWord(buf$, 6)
            If Len(LANaddr$) <= 2 Then
                LANaddr$ = "000000000000"
            Else
                LANaddr$ = StripQuote(LANaddr$)
            End If

            bAddOK = addrBookObj.AddNewAddr(HostName$, LANaddr$, IPaddr$, LANtype$, Location$)

        Loop While g_buflen% > 0

EndOfFile:
        CloseTextFile(fid%)
    End If

    Response = MsgBox("Import file completed!", MB_OK, "NetXRay")

CancelOpen:
    i = 0
End Sub

'----------------------------------------------------------
'remove double or single quote chars from the token. Assuming quote is balanced
Function StripQuote (Buf As String) As String
    Dim a_char$, tabCh$
    Dim temp$
    temp$ = Buf
    dquoteCh$ = Chr$(34)
    squoteCh$ = Chr$(39)
    If (Len(temp$) > 0) Then
        a_char$ = Left$(temp$, 1)
        If a_char$ = dquoteCh$ Or a_char$ = squoteCh$ Then
            temp$ = Right$(temp$, Len(temp$) - 1)
        End If
    End If

    If (Len(temp$) > 0) Then
        a_char$ = Right$(temp$, 1)
        If a_char$ = dquoteCh$ Or a_char$ = squoteCh$ Then
            temp$ = Left$(temp$, Len(temp$) - 1)
        End If
    End If
    StripQuote = temp$
End Function

'----------------------------------------------------------
'Counts the words in a string that are separated by ",(Double quote & comma)
'
Function CountDCSWords (S As String) As Integer
'    Dim WC% As Integer, Pos% As Integer

    If Len(S) = 0 Then
        CountDCSWords = 0
        Exit Function
    End If

    WC% = 1
    Sperator$ = Chr$(34) + ","
    Pos% = InStr(1, S, Sperator$)

    Do
        If Pos% > 0 Then
            WC% = WC% + 1
            Pos% = InStr(Pos% + 2, S, Sperator$)
        Else
            Exit Do
        End If
    Loop

    CountDCSWords = WC%
End Function

'----------------------------------------------------------
'Returns the nth word in a specific field in a string that
' are separated by ",(Double quote & comma).
'
Function GetDCSWord (S As String, Indx As Integer) As String
    Dim WC% As Integer, Count As Integer, SPos As Integer, EPos As Integer

    WC% = CountDCSWords(S)

    If Indx < 1 Or Indx > WC% Then
        GetDCSWord = Null
        Exit Function
    End If

    Sperator$ = Chr$(34) + ","
    Count = 1
    SPos = 1
    For Count = 2 To Indx
      SPos = InStr(SPos, S, Sperator$) + 2
    Next Count

    EPos = InStr(SPos, S, Sperator$)
    If EPos <= 0 Then
        EPos = Len(S)
    End If

    GetDCSWord = Trim$(Mid$(S, SPos, EPos - SPos + 1))
End Function

'----------------------------------------------------------
'Counts the words in a string that are separated by commas.
'
Function CountCSWords (S As String) As Integer
    Dim WC% As Integer, Pos% As Integer

    If Len(S) = 0 Then
        CountCSWords = 0
        Exit Function
    End If

    WC% = 1
    Pos% = InStr(1, S, ",")

    Do
        If Pos% > 0 Then
            WC% = WC% + 1
            Pos% = InStr(Pos% + 1, S, ",")
        Else
            Exit Do
        End If
    Loop

    CountCSWords = WC%
End Function

'----------------------------------------------------------
'Returns the nth word in a specific field.
'
Function GetCSWord (S As String, Indx As Integer) As String
    Dim WC% As Integer, Count As Integer, SPos As Integer, EPos As Integer

    WC% = CountCSWords(S)

    If Indx < 1 Or Indx > WC% Then
        GetCSWord = Null
        Exit Function
    End If

    Count = 1
    SPos = 1
    For Count = 2 To Indx
      SPos = InStr(SPos, S, ",") + 1
    Next Count

    EPos = InStr(SPos, S, ",") - 1
    If EPos <= 0 Then
        EPos = Len(S)
    End If

    GetCSWord = Trim$(Mid$(S, SPos, EPos - SPos + 1))
End Function

'----------------------------------------------------------
'Get a token
Function GetToken (Buf$ As String) As String
    Dim a_char$, tabCh$, crCh$, lfCh$
    Dim temp$
    tabCh$ = Chr$(9)
    crCh$ = Chr$(13)
    lfCh$ = Chr$(10)
    commaCh$ = Chr$(44)
    Pos = 1
    buflen% = Len(Buf$)
    For Pos = 1 To buflen%
        a_char$ = Mid$(Buf$, Pos, 1)
If a_char$ = " " Or a_char$ = tabCh$ Or a_char$ = crCh$ Or a_char$ = lfCh$ Or a_char$ = commaCh$ Then
            GetToken = temp$
            Exit Function
        End If
        If Pos = 1 Then
            temp$ = a_char$
        Else
            temp$ = temp$ + a_char$
        End If
    Next Pos

    GetToken = temp$
End Function

'----------------------------------------------------------
'remove the leading space, comma and tab chars
Function StripLeadingSpace (Buf As String) As String
    Dim a_char$, tabCh$
    Dim temp$

    temp$ = Buf
    tabCh$ = Chr$(9)
    commaCh$ = Chr$(44)
    While (Len(temp$) > 0)
        a_char$ = Left$(temp$, 1)
        If a_char$ <> " " And a_char$ <> tabCh$ And a_char$ <> commaCh$ Then
            StripLeadingSpace = temp$
            Exit Function
        End If
        temp$ = Right$(temp$, Len(temp$) - 1)
    Wend

    StripLeadingSpace = temp$
End Function